perm filename BIGNUM.MAC[LSP,SYS] blob
sn#067629 filedate 1973-10-19 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00009 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00002 00002 TITLE BIGNUM ARITHMETIC
00003 00003 PAGE
00004 00004 PAGEINITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
00005 00005 PAGE
00012 00006 MOVE B,A
00022 00007 CAIE T,POSNUM
00031 00008 ADD B,GC
00034 00009
00035 ENDMK
⊗;
TITLE BIGNUM ARITHMETIC
;AC DEFINITIONS
NIL=0
A=1
B=2
C=3
T=6
TT=7
T10=10
FF=16
AR1=4
F=15
P=14
D=12
S=11
AR2A=5
R=13
SP=17
INUMIN=377777
INUM0=577777
SIGN=400000
MINSGN==10
INTERNAL BIGINI
EXTERNAL CONS,FWCONS,ACONS,NCONS,XCONS,VBASE,VNOPOINT,LAST,NUMVAL
EXTERNAL POSNUM,NEGNUM,NUM1,CTY,EVBIG,REVERSE,BPR
EXTERNAL TRUE,FALSE,NUMV2,FIXNUM,FLONUM,FIX1A,LENGTH,MINUSP
EXTERNAL BPR,NUM3,EVBIG,NUMV4,OPOV,NUMV3,NUMBP2,FIX2,OPR,FLOOV
PAGE
;POWER OF TEN
PWR10: MOVEM B,BASEX#
MOVE C,B
IMUL B,B ;BASE↑2
IMUL B,B ;BASE↑4
IMUL B,C ;BASE↑5
IMUL B,B ;BASE↑TEN
MOVEM B,BASE10#
POPJ P,
B0CONS: MOVEI A,0
BNCONS: MOVEI B,0
BCONS: PUSHJ P,FWCONS
JRST CONS
QCONS=ACONS-1
PAGE;INITIALIZE THE BIGNUM SYSTEM BY CHANGING MAGIC LOCATIONS IN LISP
BIGINI: MOVE A,[JRST BPRINT]
MOVEM A,BPR ;PRINT
HRRI A,BIGEV
MOVEM A,EVBIG ;EVAL
HRRI A,NUMVB
MOVEM A,NUMV4 ;NUMVAL
HRRI A,BIGDIS
MOVEM A,NUMV3 ;BIGNUM OPS
HRRI A,BIGNP
MOVEM A,NUMBP2 ;NUMBERP
HRRI A,RDBNM
HRRM A,NUM3 ;READ
HRRI A,FIXOVL
HRRM A,OPOV ;OVERFLOW
HRRI A,BFIX
HRRM A,FIX2 ;FIX
JRST FALSE
PAGE
;BIGNUM PRINT
;BPR IN LISP IS JRST BPRINT
BPRINT: CAIN B,POSNUM
JRST BPRIN2
CAIE B,NEGNUM
JRST BPR+1
XCT "-",CTY
BPRIN2: PUSHJ P,COPY
PUSHJ P,BPRI
POPJ P,
BPRI: MOVE B,VBASE
SUBI B,INUM0
PUSHJ P,PWR10
PUSHJ P,BPRJ
SKIPE A,VNOPOINT
POPJ P,
MOVE A,BASEX
CAIE A,12
POPJ P,
MOVEI A,"."
JRST (R) ;PARTICULAR TYO
BPRJ: MOVE B,BASE10
PUSHJ P,Q1
JUMPE B,BPR2 ;ZERO QUOTIENT
PUSH P,A ;REMAINDER
MOVE A,B ;QUOTIENT
PUSHJ P,BPRJ
POP P,A ;REMAINDER
BPR1: MOVEI C,12 ;PRINT TEN DIGITS
SOJL C,CPOPJ
IDIV A,BASEX
HRLM B,(P)
PUSHJ P,BPR1+1
JRST FP7A1 ;PARTICULAR TYO FOR DIGIT
;IGNORE LEADING ZERO DIGITS FOR FIRST WORD
BPR2: JUMPE A,CPOPJ
IDIV A,BASEX
HRLM B,(P)
PUSHJ P,BPR2
FP7A1: HLRE A,(P)
ADDI A,"0"
JRST (R) ;PARTICULAR TYO FOR DIGIT
PAGE
;DIVIDES BIGNUM IN A BY INTEGER IN B
;DESTROYS ORIGINAL BIGNUM
;RETURNS REMAINDER IN A, QUOTIENT IN B
Q1: MOVEM B,Y#
PUSH P,A
HRRZ A,(A)
JUMPE A,Q1A
PUSHJ P,Q1+1
POP P,C
HRRM B,(C)
HLRZ T,(C)
MOVE B,(T)
DIV A,Y
Q1B: MOVEM A,(T) ;REPLACE OLD DIGIT
MOVE A,B
MOVE B,C
POPJ P,
Q1A: POP P,C
HLRZ T,(C)
MOVE A,(T)
IDIV A,Y
JUMPN A,Q1B ;NON-ZERO QUOTIENT - KEEP IT
HRRZM FF,(T) ;RECLAIM FULL WORD
MOVE FF,T
HRRZM F,(C) ;RECLAIM FREE WORD
HRRZ F,C
MOVEI C,0
JRST Q1B+1
PAGE
;BIGNUM READ
;NUM3 IN LISP HAS JFCL 10,RDBNM
RDBNM: PUSH P,[NIL] ;INITIAL VALUE OF BIGNUM
MOVSI C,700
HRRI C,(SP) ;BYPE POINTER TO SPEC PDL
MOVEM T,TSAV#
MOVEM C,RDPTR#
HRRZ B,NUM1 ;BASE OF NUMBER
PUSHJ P,PWR10
RDNM1: MOVEI C,12 ;TEN DIGITS AT A TIME
MOVEI A,0
ILDB B,RDPTR
JUMPE B,RDNM2 ;END OF BIGNUM
IMUL A,BASEX
ADDI A,-"0"(B)
SOJG C,.-4
MOVE B,BASE10
PUSHJ P,RDSUB
JRST RDNM1
RDNM2: CAIN C,12 ;NO DIGITS IN LAST SUPERDIGIT
JRST RDNM3
HRREI C,-12(C) ;NUMBER OF DIGITS IN LAST
MOVEI B,1
IMUL B,BASEX
AOJL C,.-1 ;COMPUTE BASEX↑(NUMBER OF DIGITS)
PUSHJ P,RDSUB
RDNM3: MOVEI B,POSNUM
MOVE T,TSAV
TLNE T,MINSGN ;SIGN OF BIGNUM
MOVEI B,NEGNUM
POP P,A
SUB P,[XWD 1,1]
JRST QCONS
RDSUB: MOVE C,-1(P)
PUSHJ P,BTIME1 ;BIGNUM(C)*INT(B)+INT(A)
MOVEM A,-1(P)
POPJ P,
PAGE
BTIME0: PUSH P,B
PUSHJ P,COPY
MOVE C,A
POP P,B
MOVEI A,0
;BIG(C)*INT(B)+INT(A)
BTIME1: JUMPE C,BNCONS ;END OF BIGNUM
MOVEM B,MULR# ;MULTIPLIER
PUSH P,C ;BIGNUM
BT1B: MOVEM A,CARRY#
MOVS T,(C)
MOVE A,(T)
MUL A,MULR
ADD B,CARRY
TLZE B,SIGN
ADDI A,1
BT1E: MOVEM B,(T) ;STORE LOW ORDER PRODUCT+CARRY IN BIGNUM
HLRZS T ;(CDR BIGNUM)
JUMPE T,BT1C ;END OF BIGNUM
MOVE C,T
JRST BT1B
BT1C: JUMPE A,POPAJ ;NO HIGH ORDER PART
PUSHJ P,BNCONS ;CONSES FOR REMAINING HIGH ORDER PART
HRRM A,(C) ;RPLACD END OF BIGNUM
POPAJ: POP P,A
CPOPJ: POPJ P,
PAGE
;BIGNUM COPY
COPY: JUMPE A,CPOPJ
HLRZ B,(A)
PUSH P,(B)
HRRZ A,(A)
PUSHJ P,COPY
MOVE B,A
POP P,A
JRST BCONS
;BIGNUM RECLAIM
RECLAIM:
CAILE A,INUMIN
POPJ P,
EXCH A,F
EXCH A,(F)
HRRZS A
EXCH A,F
EXCH A,(F)
HLRZ B,A ;TYPE
HRRZS A
CAIE B,POSNUM
CAIN B,NEGNUM
JRST UNCONS
POPJ P,
;BIGNUM UNCONS
UNCONS:
JUMPE A,CPOPJ
HLRZ B,(A)
MOVEM FF,(B)
MOVE FF,B
EXCH A,F
EXCH A,(F)
HRRZS A
JRST UNCONS
;EVBIG IN LISP HAS JRST BIGEV
BIGEV: CAIE TT,POSNUM
CAIN TT,NEGNUM
POPJ P,
HRRZ AR1,(AR1)
JRST EVBIG+1
PAGE
;BIGNUM MINUSP
MINSP2: CAIN B,POSNUM
JRST FALSE
JRST TRUE
;BIGNUM MINUS
MINS2: CAIN B,POSNUM
SKIPA B,[NEGNUM]
ABS2: MOVEI B,POSNUM ;BIGNUM ABS
JRST QCONS
;COMPARE TWO BIGNUMS A<B
BCMPR: PUSHJ P,BDIF
PUSH P,A
PUSHJ P,MINUSP
EXCH A,(P)
PUSHJ P,RECLAIM
JRST POPAJ
BEQUAL: PUSHJ P,BDIF
POP P,C
CAIN A,INUM0
JRST TRUE
MOVE P,C
PUSHJ P,RECLAIM
JRST FALSE
PAGE
;DIFFERENCE OF TWO BIGNUMS
BDIF: PUSHJ P,COMPSN ;COMPLEMENT SIGN OF BIGNUM IN B
;SUM OF TWO BIGNUMS
;BIGNUMS IN A AND B; SIGN(A) IN T, SIGN(B) IN TT
BPLUS: PUSH P,B
PUSHJ P,COPY
EXCH A,(P)
PUSHJ P,COPY
POP P,C
MOVE B,A
MOVEI A,0
CAME T,TT
JRST BDIF1 ;SIGNS DIFFERENT
PUSH P,T ;SIGN OF RESULT
PUSHJ P,BADD
POP P,B
JRST QCONS
BDIF1: CAIN TT,POSNUM
EXCH B,C
PUSHJ P,BSUB ;POSNUM IN C, NEGNUM IN B
JUMPL B,BDIF3
PUSHJ P,SUPRSS
MOVEI B,POSNUM
JRST MAKBIG
BDIF3: PUSHJ P,COMPLM
MOVEI B,NEGNUM
JRST MAKBIG
BSUB: MOVNI TT,1
MOVSI T,(SUB TT,(B))
JRST BAS
BADD: MOVEI TT,1
MOVSI T,(ADD TT,(B))
PAGE
;CRY(A)(+ OR -) BIG(B) + BIG(C) → A, SIGN → B.
;DESTROYS BOTH BIGNUMS
BAS: HRRM TT,BCRY
PUSH P,B
BP2A: HRRM B,BTMP
MOVS B,(B)
HLRZ TT,(C)
EXCH TT,FF
EXCH TT,(FF) ;RECLAIM FULL WORD
EXCH C,F
EXCH C,(F) ;RECLAIM FREE WORD
ADD TT,A
XCT T ;BIG(C) (+ OR -) BIG (B)
MOVEI A,0
TLZE TT,SIGN ;TURN OFF HIGH BIT
BCRY: HRREI A,. ;SET CARRY IF OVERFLOW OR NEGATIVE
BP2B: MOVEM TT,(B)
HLRZS B
HRRZS C
JUMPE B,BP2F ;END OF B
JUMPN C,BP2A
JRST BP2D ;FINISH WITH CARRY (+ OR -) BIG(B)
BP2F: JUMPE C,BP2H ;END OF C ALSO
EXCH B,C
HRRM B,@BTMP ;RPLACD END OF BIG(B) WITH REST OF C
MOVSI T,(ADD TT,(B)) ;FINISH WITH BIG(C) + CARRY
BP2D: HRRM B,BTMP
MOVS B,(B)
MOVE TT,A
XCT T ;CARRY (+ OR -) INTEGER
JUMPL TT,BP2K
MOVEM TT,(B)
CAME T,[SUB TT,(B)]
JRST POSXIT ;CAN QUIT NOW
MOVEI A,0 ;TURN OFF CARRY
JRST BP2L ;CONTINUE TO NEGATE
BP2K: HRRE A,BCRY
TLZ TT,SIGN ;MAKE HIGH BIT ZERO
MOVEM TT,(B)
BP2L: HLRZS B
JUMPN B,BP2D
BP2H: JUMPLE A,XIT ;NO CARRY
PUSHJ P,BNCONS
BTMP: HRRM A,. ;RPLACD END OF BIGNUM WITH CARRY
POSXIT: MOVEI B,0 ;SIGN POSITIVE
JRST POPAJ
XIT: MOVE B,A ;SIGN IN B
JRST POPAJ
PAGE
;SUPPRESS LEADING ZEROS FROM BIGNUM
SUPRSS: SKIPA C,[JRST COMPL7]
;COMPLEMENT BIGNUM (2↑35 COMPLEMENT)
COMPLM: MOVSI C,(SUBM T,(B))
JUMPE A,CPOPJ
PUSH P,A
HRLZI T,SIGN
MOVEI TT,0
COMPL4: MOVS B,(A)
SKIPN (B)
JUMPE TT,COMPL3
XCT C
HRLOI T,SIGN-1
COMPL7: SKIPE (B)
MOVEM A,TT
COMPL3: HLRZ A,B
JUMPN A,COMPL4 ;CONTINUE
JUMPE TT,COMPL5 ;ALL ZEROS
HRRZ A,(TT)
HLLZS (TT) ;RPLACD HIGH ORDER NON-ZERO WITH NIL
COMPL6: PUSHJ P,UNCONS ;UNCONS LEADING ZEROS
JRST POPAJ
COMPL5: EXCH A,(P)
JRST COMPL6
;SIGN(TT)⊗SIGN(T) → TT
MQSIGN: CAIN T,POSNUM
JRST CPOPJ
;-SIGN(TT) → TT
COMPSN: CAIN TT,POSNUM
SKIPA TT,[NEGNUM]
MOVEI TT,POSNUM
POPJ P,
PAGE
;BIGNUM MULTIPLY
;BIG (A) * BIG (B) → A, SIGNS IN T,TT
BTIMES: PUSHJ P,MQSIGN
PUSH P,TT ;SAVE SIGN OF RESULT
PUSHJ P,BMUL
POP P,B
JRST MAKBIG
;0(P) IS PARTIAL RESULT
;-1(P) IS REMAINING REVERSED MULTIPLIER
;-2(P) IS MULTIPLICAND
BMUL: PUSH P,B
PUSHJ P,REVERSE
PUSH P,A
MOVEI A,0
PUSH P,A
BTLOOP: SKIPN C,-1(P)
JRST BTEND ;END OF MULTIPLIER
JUMPE A,BTLP2 ;FIRST TIME
MOVE B,A
PUSHJ P,FWCONS-1
PUSHJ P,CONS ;INCREASE LENGTH OF PRODUCT
BTLP2: MOVEM A,(P)
MOVE A,-2(P)
PUSHJ P,COPY
MOVS B,(C) ;NEXT MULTIPLIER DIGIT
MOVE C,A
HLRZM B,-1(P)
MOVE B,(B)
MOVEI A,0
PUSHJ P,BTIME1
MOVE C,(P)
JUMPE C,BTLOOP ;NO ADD NEEDED ON FIRST TIME
MOVE B,A
MOVEI A,0
PUSHJ P,BADD
JRST BTLOOP
BTEND: SUB P,[XWD 3,3]
JRST SUPRSS
PAGE
;EXTENSIONS OF INTERPRETER ROUTINES AND TESTS
;ADDITION TO NUMVAL. NUMV4 IN LISP CHANGED TO JRST NUMVB
NUMVB: CAIE B,POSNUM
CAIN B,NEGNUM
JRST NUMVD2
MOVE A,AR1
JRST NUMV2 ;PRINT ERROR MESSAGE
NUMVD2: POP P,C ;ADDRESS OF (PUSHJ P,NUMVAL) +1
HLRZ C,(C)
CAIN C,(JUMPN A,) ;ZEROP
JRST FALSE
CAIN C,(JUMPGE A,) ;MINUSP
JRST MINSP2
CAIN C,(MOVNS) ;MINUS
JRST MINS2
CAIN C,(MOVMS) ;ABS
JRST ABS2
CAIN C,(CAIE B,) ;FIX
JRST POPAJ
HALT ;TEMPORARY
;EXTENSION TO NUMBERP. NUMBRP4 IN LISP CHANGED TO JRST BIGNP
BIGNP: CAIE A,POSNUM
CAIN A,NEGNUM
JRST TRUE
JRST FALSE
PAGE
;EXTENSION TO OP. OPOV IN LISP CHANGED TO JFCL 10,FIXOVL
FIXOVL: HLRZ C,(C)
CAIN C,(IMUL A,)
JRST REMUL ;TIMES OVERFLOWED. RECOMPUTE
TLC A,SIGN ;ALL OTHER CASES JUST OVERFLOWED 1 BIT
MOVM B,A
MOVE TT,A
MOVEI A,1
PUSHJ P,MKBG
JRST QCONS
REMUL: MOVE A,AR1
MOVEI B,FIXNUM
MOVEI T,FIXNUM
PUSHJ P,BIGTST
JRST BTIMES ;USE THE BIGNUM MULTIPLICATION
;EXTENSION TO OP. NUMV3 CHANGED TO JRST BIGDIS
;BIGDIS DETERMINES THE BIGNUM OPERATION TO BE PERFORMED
BIGDIS: CAIE T,FLONUM
CAIN B,FLONUM
JRST FLOBIG ;OPERATION WITH FLT PT OPERAND
PUSHJ P,BIGTST
HLRZ C,(C)
CAIN C,(ADD A,) ;PLUS
JRST BPLUS
CAIN C,(SUB A,) ;DIF
JRST BDIF
CAIN C,(IMUL A,) ;TIMES
JRST BTIMES
CAIN C,(IDIV A,) ;QUOTIENT
JRST BQUO
CAIN C,(JRST) ;LESSP OR GREATERP
JRST BCMPR
CAIN C,(JUMPN 0,) ;DIVIDE
JRST BDIV
CAIN C,(JUMPA) ;GCD
JRST GCD
CAIN C,(JUMPL) ;EQUAL
JRST BEQUAL
HALT ;TEMPROARY
PAGE
;TRANSFORMS GENERAL NUMBERS IN (A,T),(TT,B)
;INTO BIGNUMS IN (A,T),(B,TT), VALUES IN A,B; SIGNS IN T,TT.
BIGTST: EXCH B,T ;FUNNY AC USAGE IN LISP
PUSH P,T
PUSH P,TT
PUSHJ P,BIGSUB ;CONVERT NUMBER ORIGINALLY IN A,T
EXCH B,-1(P)
EXCH A,(P)
PUSHJ P,BIGSUB ;CONVERT NUMBER ORIGINALLY IN TT,B
MOVE TT,B
MOVE B,A
POP P,A
POP P,T
POPJ P,
BIGSUB: CAIE B,POSNUM
CAIN B,NEGNUM
POPJ P, ;NO CONVERSION NECESSARY
CAIE B,FIXNUM
JRST NUMV2 ;CHECK FOR FLONUM
MOVEI B,0
MOVE TT,A ;GET VALUE OF NUMBER
MOVM A,TT
JUMPGE A,BIGSRT
MOVEI A,1 ;BASTARD CASE OF -2↑35
MKBG: PUSHJ P,MKBIG
JRST BIGSND
BIGSRT: PUSHJ P,BCONS
BIGSND: SKIPGE TT
SKIPA B,[NEGNUM]
MOVEI B,POSNUM
POPJ P,
MKBIG: PUSH P,B
PUSHJ P,BNCONS
MOVE B,A
POP P,A
JRST BCONS
PAGE
;MAKE A LISP NUMBER FROM BIGNUM -- A IS LIST, B IS SIGN
MAKBIG: JUMPE A,FIX1A ;NULL LIST PRODUCES ZERO
HRRZ C,(A)
JUMPN C,QCONS ;A REAL BIGNUM
HLRZ C,(A) ;ONLY ONE WORD OF PRECISION
MOVE C,(C)
CAIE B,POSNUM
MOVNS C ;NEGATIVE
PUSHJ P,UNCONS
MOVE A,C
JRST FIX1A
PAGE
FLOBIG: CAIE T,FLONUM
JRST FLBG2
MOVE A,(A)
EXCH A,TT
EXCH B,T
PUSHJ P,BFLT
EXCH A,TT
JRST OPR
FLBG2: PUSHJ P,BFLT
MOVE TT,(TT)
JRST OPR
;MAKE A FLOATING PT NUMBER OUT OF A BIGNUM
BFLT: PUSH P,C
PUSH P,T
CAIE T,POSNUM
CAIN T,NEGNUM
SKIPA T,[-200]
JRST NUMV2
BFLT2: MOVE C,B
HLRZ B,(A)
HRRZ A,(A)
ADDI T,43
JUMPN A,BFLT2 ;FIND LAST TWO WORDS OF BIGNUM
MOVE B,(B)
MOVE C,(C)
BFLT3: TLNE B,SIGN/2
JRST BFLT4
ASHC B,1
SOJA T,BFLT3 ;NORMALIZE B,C
BFLT4: JUMPGE T,FLOOV
ASH B,-10
DPB T,[POINT 8,B,8]
MOVE A,B
POP P,T
POP P,C
CAIE T,POSNUM
MOVNS A
POPJ P,
;MAKE A BIGNUM FROM A FLT PT NUMBER
BFIX: MOVE A,(P)
PUSHJ P,NUMVAL
MOVMS A
MULI A,400
MOVEI C,-243(A) ;#LEFT SHIFTS NEEDED
IDIVI C,43 ;C←#EXTRA WORDS-1, D←#SHIFTS
MOVEI A,0
ASHC A,(C+1)
PUSH P,B
PUSHJ P,BNCONS
MOVE B,A
POP P,A
PUSHJ P,BCONS
SOJL C,BFIX2
MOVE B,A
MOVEI A,0
PUSHJ P,BCONS
SOJGE C,.-3
BFIX2: POP P,TT
PUSHJ P,BIGSND
JRST QCONS
PAGE
;BIGNUM DIVIDE
BDIV: PUSHJ P,MQSIGN ;COMPLEMENT SIGN OF TT IF T IS NEGNUM
PUSH P,T ;SIGN OF REMAINDER
PUSH P,TT ;SIGN OF QUOTIENT
PUSHJ P,DIVSUB
BDIV2: EXCH B,(P)
PUSHJ P,MAKBIG ;QUOTIENT
MOVE B,-1(P)
MOVEM A,-1(P)
POP P,A
PUSHJ P,MAKBIG ;REMAINDER
POP P,B
JRST XCONS
BQUO: PUSHJ P,MQSIGN
PUSH P,TT
PUSHJ P,DIVSUB
PUSH P,A
MOVE A,B
PUSHJ P,UNCONS
POP P,A
POP P,B
JRST MAKBIG
DIVSUB: HRRZ C,(B)
JUMPN C,DIV1
;NULL(CDR B) MEANS SINGLE LENGTH DIVISOR
BQUO1: PUSH P,B
PUSHJ P,COPY
POP P,B
HLRZ B,(B)
MOVE B,(B)
PUSHJ P,Q1
PUSH P,B ;QUOTIENT
PUSHJ P,BNCONS
MOVE B,A
JRST POPAJ
PAGE
;DIV1 DOES LONG DIVISION OF X/Y
;ENTER WITH X IN A, Y IN B.
DIV1: PUSH P,A ;X
PUSH P,B ;Y
MOVE A,B
PUSHJ P,HIDIG
HRLOI A,SIGN/2-1
IDIV A,(C) ;(BETA/2-1)/Y[N-1]+1
ADDI A,1
MOVEM A,SCALE#
MOVE B,A
MOVE A,(P) ;Y - DIVISOR
PUSHJ P,BTIME0 ;SCALE*Y
MOVEM A,V ;SCALED DIVISOR
MOVEM A,(P) ;PROTECT V FROM GC
PUSHJ P,HIDIG
POP C,VH ;V[N-1]
POP C,VH1 ;V[N-2]
MOVE A,-1(P) ;X - NUMERATOR
PUSHJ P,COPY
PUSHJ P,EXTND
MOVE B,SCALE
MOVE C,A
PUSHJ P,BTIME1-1 ;SCALE*X -- SCALED NUMERATOR
MOVEM A,-1(P) ;U
PUSH P,[NIL]
HRRZM P,QUO# ;POINTER TO QUOTIENT LIST
PUSHJ P,LENGTH
PUSH P,A
MOVE A,V#
PUSHJ P,LENGTH
POP P,B
SUB B,A ;LENGTH(U)-LENGTH(V)
MOVE A,-2(P) ;U
JUMPLE B,DIV1X ;SPECIAL CASE OF U<V
PUSHJ P,DIV2 ;CARRY OUT DIVISION WITH PARAMETERS
DIV1X: PUSHJ P,SUPRSS ;SUPPRESS LEADING ZEROS OF REMAINDER
JUMPE A,DIV1Y ;ZERO REMAINDER
MOVE B,SCALE
PUSHJ P,Q1 ;U/SCALE - FINAL REMAINDER IN B
MOVE A,B
DIV1Y: EXCH A,(P)
PUSHJ P,SUPRSS ;SUPPRESS LEADING ZEROS IN QUOTIENT
POP P,B
SUB P,[XWD 2,2]
POPJ P,
;RECURSIVE FUNCTION TO POSITION V PROPERLY WITH RESPECT TO U.
; ON SUCCESSIVE CALLS TO DIV3 WHICH CALCULATES QUOTIENT DIGITS.
;ENTER DIV2 WITH U IN A, N IN B. N= LENGTH(U)-LENGTH(V)-1.
DIV2: SOJLE B,DIV3
PUSH P,A ;U
HRRZ A,(A)
PUSHJ P,DIV2
HRRM A,@(P) ;(RPLACD U,(DIV3(CDR U)))
POP P,A
JRST DIV3
PAGE
;ENTER WITH U[J] IN A
DIV3: PUSH P,A ;UJ
PUSHJ P,HIDIG
POP C,A ;UH
CAML A,VH#
JRST DIVCS1 ;STRANGE CASE WHEN UH≥VH
POP C,B ;UH1
DIV A,VH ;(UH*BETA+UH1)/VH
PUSH P,A ;QUOTIENT DIGIT
L1: MOVEM B,REM# ;REMAINDER
MUL A,VH1#
SUB A,REM ;(VH1*QUO)-BETA*REM
CAMGE B,(C) ;UH2
SUBI A,1
JUMPG A,DIVCS2 ;QUOTIENT TOO BIG
L4: MOVE A,V
MOVE B,(P) ;QUOTIENT DIGIT
PUSHJ P,BTIME0 ;Q*V
MOVE C,-1(P) ;UJ
MOVE B,A
MOVEI A,0
PUSHJ P,BSUB ;UJ-Q*V
JUMPL B,DIVCS3 ;QUOTIENT TOO BIG
L3: MOVEM A,-1(P) ;NEW UJ
POP P,A ;QUOTIENT DIGIT
MOVE B,@QUO
PUSHJ P,BCONS
MOVEM A,@QUO ;NEW QUOTIENT LIST
MOVE A,(P)
PUSHJ P,DIVSRT ;SHORTEN UJ BY ONE DIGIT
JRST POPAJ
PAGE
;SPECIAL CASE OF UH≥VH
DIVCS1: HRLOI A,SIGN-1 ;BETA-1
PUSH P,A
POP C,B ;UH1
ADD B,VH ;R←UH1+VH
JUMPL B,L4
JRST L1
;SPECIAL CASE CORRECTION FOR QUOTIENT
DIVCS2: SOS A,(P) ;QUOTIENT←QUOTIENT-1
MOVE B,REM
ADD B,VH ;R←R+VH
JRST L1
;SPECIAL CASE OF QUOTIENT TOO LARGE
DIVCS3: SOS (P) ;QUOTIENT←QUOTIENT-1
PUSH P,A
MOVE A,V
PUSHJ P,COPY
MOVE C,A
POP P,B
MOVEI A,0
PUSHJ P,BADD ;U←U+V
MOVEM A,-1(P)
PUSHJ P,DIVSRT ;SHORTEN OVERFLOWED DIGIT
JRST L3+1
PAGE
;PUSHES SUCCESSIVE DIGITS OF LIST IN A ONTO PDL
;RETURNS C POINTING TO PDL LOCATION OF LAST DIGIT
HIDIG: MOVE C,P
MOVS B,(A)
PUSH P,(B)
HLRZ A,B
JUMPN A,HIDIG+1
EXCH C,P
POPJ P,
;SHORTEN LIST BY ONE
DIVSRT: MOVE C,A
HRRZ A,(A)
HRRZ B,(A) ;CDDR
JUMPN B,.-3
HLLZS (C) ;NULL (CDDR C) => RPLACD(C NIL)
HLRZ B,(A)
JRST UNCONS
;LENGTHEN LIST BY ONE
EXTND: PUSH P,A
PUSHJ P,LAST
MOVE T,A
PUSHJ P,B0CONS
HRRM A,(T)
JRST POPAJ
PAGE
GA==4
GB==5
GC==6
GD==7
UP==10
VP==11
Q==12
;BIGNUM GCD
GCD: PUSH P,B
PUSHJ P,COPY
EXCH A,(P) ;V
PUSHJ P,COPY
PUSH P,A ;U
PUSHJ P,COPY
MOVE C,A
MOVE A,-1(P)
PUSHJ P,COPY
MOVE B,A ;U
MOVEI A,0
PUSHJ P,BSUB ;V-U
PUSH P,B
PUSHJ P,BSUBND
JUMPE A,GCDSC1 ;U=V
PUSHJ P,UNCONS
POP P,B
JUMPGE B,GCD2 ;U≥V
MOVE A,(P)
EXCH A,-1(P)
MOVEM A,(P)
PAGE
;NOW V<U V IN -1(P), U IN (P)
GCD2: MOVE A,-1(P)
JUMPE A,GCDEND ;V IS ZERO
HRRZ B,(A)
JUMPE B,GCDSING ;V IS SINGLE PRECISION
PUSHJ P,LENGTH ;LENGTH (V)
MOVE T,A
MOVE A,(P) ;U
PUSHJ P,LENGTH
SUB A,T ;L(U)-L(V)
JUMPE A,GCD4
SOJN A,GCD7A ;>1
MOVE A,-1(P) ;V
PUSHJ P,EXTND ;LENGTHEN V BY ONE HIGH ORDER ZERO
GCD4: MOVE A,(P) ;U
PUSHJ P,HIDIG
HRLOI A,SIGN/2-1 ;BETA/2-1
IDIV A,(C) ;(BETA/2-1)/U[N-1]+1
ADDI A,1
MOVEM A,SCALE
PUSHJ P,GCSB
MOVE UP,A ;SCALE*UH
MOVE A,-1(P) ;V
PUSHJ P,HIDIG
PUSHJ P,GCSB
MOVE VP,A ;SCALE*VH
MOVEI GA,1
MOVEI GD,1
SETZB GC,GB
PAGE
GCD5: MOVE A,UP
ADD A,GA
MOVE B,VP
ADD B,GC
JUMPE B,GCD7
JUMPL A,GCD5X ;OVERFLOW CASE
IDIV A,B ;(U'+A)/(V'+C)
GCD5A: MOVE Q,A
MOVE A,UP
ADD A,GB
MOVE B,VP
ADD B,GD
JUMPE B,GCD7
SKIPG B
TDZA A,A ;SPECIAL CASE OF V'+D = BETA
IDIV A,B ;(U'+B)/(V'+D)
CAME A,Q
JRST GCD7
MOVE A,GC
EXCH GA,GC ;A'←C
IMUL A,Q
SUB GC,A ;C'←A-Q*C
MOVE A,GD
EXCH GB,GD ;B'←D
IMUL A,Q
SUB GD,A ;D'←B-Q*D
MOVE A,VP
EXCH UP,VP ;UP'←VP
IMUL A,Q
SUB VP,A ;VP'←UP-Q*VP
JRST GCD5
PAGE
;SPECIAL CASE WHEN U'+A=BETA
GCD5X: MOVEI A,1
MOVE C,B
MOVEI B,0
DIV A,C
JRST GCD5A
GCD7: JUMPE GB,GCD7A
MOVE A,(P) ;U
MOVE B,-1(P) ;V
PUSH P,GC
PUSH P,GD
PUSHJ P,GCDSB ;A*U+B*V
POP P,GB
POP P,GA
EXCH A,(P) ;U
MOVE B,-1(P)
PUSHJ P,GCDSB ;C*U+D*V
MOVEM A,-1(P) ;V
JRST GCD2
GCDSB: PUSH P,GA
PUSH P,GB
PUSH P,B
MOVM B,GA
PUSHJ P,BTIME0
EXCH A,(P) ;B
MOVM B,-1(P) ;GB
PUSHJ P,BTIME0
POP P,B ;A*GA
POP P,GA
POP P,GB
XOR GA,GB
MOVE C,A
MOVEI A,0
JUMPGE GA,BADD ;SIGNS SAME
PUSHJ P,BSUB ;SIGNS DIFFERENT
BSUBND: JUMPGE B,SUPRSS
JRST COMPLM
GCD7A: MOVE A,-1(P)
PUSHJ P,SUPRSS
MOVE B,A
MOVE A,(P)
PUSHJ P,DIV1 ;U/V
EXCH B,-1(P) ;V←REMAINDER
MOVEM B,(P) ;U←V
PUSHJ P,UNCONS ;DONT NEED QUOTIENT
JRST GCD2
PAGE
GCDSING:
POP P,A ;U
MOVE B,(P) ;V - SINGLE PRECISION
HLRZ B,(B)
MOVE B,(B)
MOVEM B,(P)
PUSHJ P,Q1 ;U MOD V → A
POP P,B ;A < B
JUMPE A,GCDS2
;SINGLE PRECISION GCD
IDIV B,A
MOVE B,A
MOVE A,C
JUMPN A,.-3
GCDS2: MOVE A,B
JRST FIX1A
GCSB: MOVE A,-1(C)
MUL A,SCALE
MOVE B,A
MOVE A,(C)
IMUL A,SCALE
ADD A,B
POPJ P,
PAGE
GCDSC1: SUB P,[XWD 2,2]
POP P,A
MOVEI B,POSNUM
JRST MAKBIG
GCDEND: POP P,A ;U IS RESULT
SUB P,[XWD 1,1]
MOVEI B,POSNUM
JRST MAKBIG
END